home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / menucol / frmmenu.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-10-23  |  9.1 KB  |  201 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMenu 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    Caption         =   "Vertical Menu Columns Demo"
  6.    ClientHeight    =   4620
  7.    ClientLeft      =   3135
  8.    ClientTop       =   1965
  9.    ClientWidth     =   7365
  10.    ForeColor       =   &H80000008&
  11.    LinkTopic       =   "Form1"
  12.    PaletteMode     =   1  'UseZOrder
  13.    ScaleHeight     =   308
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   491
  16.    Begin VB.Menu mnuTwo 
  17.       Caption         =   "Two Level Menu"
  18.       Begin VB.Menu mnuList1 
  19.          Caption         =   "Menu Item 1"
  20.          Index           =   0
  21.       End
  22.       Begin VB.Menu mnuPopUp 
  23.          Caption         =   "More Sub Menus"
  24.          Begin VB.Menu mnuList4 
  25.             Caption         =   "Menu Item 1"
  26.             Index           =   0
  27.          End
  28.       End
  29.    End
  30.    Begin VB.Menu mnuThree 
  31.       Caption         =   "Three Level Menu"
  32.       Begin VB.Menu mnuSub1 
  33.          Caption         =   "With Vertical Separator"
  34.          Begin VB.Menu mnuList2 
  35.             Caption         =   "Menu Item 1"
  36.             Index           =   0
  37.          End
  38.       End
  39.       Begin VB.Menu mnuSub2 
  40.          Caption         =   "Without Vertical Separator"
  41.          Begin VB.Menu mnuList3 
  42.             Caption         =   "Menu Item 1"
  43.             Index           =   0
  44.          End
  45.       End
  46.    End
  47. Attribute VB_Name = "frmMenu"
  48. Attribute VB_GlobalNameSpace = False
  49. Attribute VB_Creatable = False
  50. Attribute VB_PredeclaredId = True
  51. Attribute VB_Exposed = False
  52.   Option Explicit
  53.   ' demo project showing how to manipulate VB menus using the API
  54.   ' by Bryan Stafford of New Vision Software
  55.  - newvision@imt.net
  56.   ' this demo is released into the public domain "as is" without
  57.   ' warranty or guaranty of any kind.  In other words, use at
  58.   ' your own risk.
  59.   ' API calls used
  60.   Private Declare Function GetMenu& Lib "user32" (ByVal hwnd&)
  61.   Private Declare Function GetSubMenu& Lib "user32" (ByVal hMenu&, ByVal nPos&)
  62.   Private Declare Function GetMenuItemID& Lib "user32" (ByVal hMenu&, ByVal nPos&)
  63.   Private Declare Function ModifyMenu& Lib "user32" Alias "ModifyMenuA" (ByVal hMenu&, _
  64.                           ByVal nPosition&, ByVal wFlags&, ByVal wIDNewItem&, ByVal lpString$)
  65.   Private Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex&)
  66. Private Sub Form_Load()
  67.   ' It seems that there is a limit to the number of menus that may be added
  68.   ' in any VB application.  I discovered this by setting the number of menus
  69.   ' in each menu array ever higher until I received an 'Out of Memory' error.
  70.   ' The error occurred at 337 items between all three menu arrays.  This does
  71.   ' not take into account the other higher level menus in the application.
  72.   ' position the form
  73.   Move (Screen.Width \ 2) - (Width \ 2), 0
  74.   Form_Paint ' Autoredraw is set to true so we need to call the form paint to draw the form text
  75.   Const MF_BYPOSITION As Long = &H400&   '<--** tells modifymenu to act on the menu at the specified position
  76.   Const MF_MENUBARBREAK As Long = &H20&  '<--** tells modifymenu to add another column with a vertical separator
  77.   Const MF_MENUBREAK As Long = &H40&     '<--** tells modifymenu to add another column without a vertical separator
  78.   Const SM_CYFULLSCREEN As Long = 17&    '<--** height of client area of a maximized window
  79.   Const SM_CYMENU  As Long = 15&         '<--** height of menu
  80.   Dim menuheight&, breakpoint&, menuhWnd&, submenuhWnd&, nextsubmenuhWnd&
  81.   Dim i&, loopnum&, loopstr$, msg$
  82.   ' get the client area height and divide it by the height of a menu
  83.   ' to get the point where we need to *wrap* the menu to a new column
  84.   menuheight = GetSystemMetrics(SM_CYMENU)
  85.   breakpoint = (GetSystemMetrics(SM_CYFULLSCREEN) - menuheight) \ menuheight
  86.   menuhWnd = GetMenu(hwnd) ' get the handle of the menu for *this* form
  87.   submenuhWnd = GetSubMenu(menuhWnd, 0) ' get the handle of the first sub menu
  88.   For i = 1 To 99  ' load the first menu array (rember, zero is already loaded)
  89.     On Error GoTo TooManyMenus
  90.     Load mnuList1(i)
  91.     On Error GoTo 0
  92.     mnuList1(i).Caption = "Menu Item " & CStr(i + 1)
  93.                      ' if we've reached the breakpoint then add a new column with
  94.     If i Mod breakpoint = 0 Then   ' a vertical bar the proper ID must be specified
  95.       Call ModifyMenu(submenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
  96.                               GetMenuItemID(submenuhWnd, i), "Menu Item " & CStr(i + 1))
  97.     End If
  98.   Next
  99.                     
  100.                     ' get the handle of the popup menu that is in the position
  101.   submenuhWnd = GetSubMenu(submenuhWnd, i) ' at AFTER the menus we just loaded
  102.   For i = 1 To 9  ' load the popup sub menu array of the first menu array (rember, zero is already loaded)
  103.     On Error GoTo TooManyMenus
  104.     Load mnuList4(i)
  105.     On Error GoTo 0
  106.     mnuList4(i).Caption = "Menu Item " & CStr(i + 1)
  107.                      ' if we've reached the breakpoint then add a new column with a vertical bar
  108.     If i Mod 5 = 0 Then                          ' the proper ID must be specified
  109.       Call ModifyMenu(submenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
  110.                                 GetMenuItemID(submenuhWnd, i), "Menu Item " & CStr(i + 1))
  111.     End If
  112.   Next
  113.   submenuhWnd = GetSubMenu(menuhWnd, 1) ' get the sub menu of the second top level menu (position 1)
  114.   nextsubmenuhWnd = GetSubMenu(submenuhWnd, False) ' get the first sub menu of the sub menu
  115.   loopnum = 1 ' set variable for trapped errors
  116.   For i = 1 To 99  ' load the second menu array (rember, zero is already loaded)
  117.     On Error GoTo TooManyMenus
  118.     Load mnuList2(i)
  119.     On Error GoTo 0
  120.     mnuList2(i).Caption = "Menu Item " & CStr(i + 1)
  121.                      ' if we've reached the breakpoint then add a new column with a vertical bar
  122.     If i Mod breakpoint = 0 Then                        ' the proper ID must be specified
  123.       Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
  124.                                GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))
  125.     End If
  126.   Next
  127.   nextsubmenuhWnd = GetSubMenu(submenuhWnd, 1) ' get the second sub menu of the sub menu
  128.   loopnum = 2 ' set variable for trapped errors
  129.   For i = 1 To 99   ' load the third menu array (rember, zero is already loaded)
  130.     On Error GoTo TooManyMenus
  131.     Load mnuList3(i)
  132.     On Error GoTo 0
  133.     mnuList3(i).Caption = "Menu Item " & CStr(i + 1)
  134.                       ' if we've reached the breakpoint then add a new column without a vertical bar
  135.     If i Mod breakpoint = 0 Then                       ' the proper ID must be specified
  136.       Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBREAK, _
  137.                                 GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))
  138.     End If
  139.   Next
  140. Exit Sub
  141. TooManyMenus:
  142.   ' display message telling where the error occurred
  143.   Select Case loopnum
  144.     Case 0
  145.       loopstr$ = "first"
  146.     Case 1
  147.       loopstr$ = "second"
  148.     Case 2
  149.       loopstr$ = "third"
  150.   End Select
  151.   msg$ = "Ran out of menu space while loading sub menu number " & CStr(i) & " in the " & loopstr$ & " loop."
  152.   MsgBox msg$, 48, "ERROR!"
  153.   On Error GoTo 0
  154.   Exit Sub
  155. End Sub
  156. Private Sub Form_Paint()
  157.   ' print the text on the form
  158.   CurrentY = 70
  159.   CurrentX = 40
  160.   Print "This application demonstrates adding columns and vertical bars to Visual Basic menus."
  161.   CurrentX = 40
  162.   Print "Explore the menus on this form to see examples of how VB menus can be *extended*."
  163.   Print
  164.   Print
  165.   CurrentX = 40
  166.   Print "Developed by Bryan Stafford of New Vision Software
  167.  and released into the public"
  168.   CurrentX = 40
  169.   Print "domain.  This application is provided ""As Is"" with no guarantee or warranty of any"
  170.   CurrentX = 40
  171.   Print "kind.  You may redistribute this application and the source code so long as no fee is "
  172.   CurrentX = 40
  173.   Print "charged and no changes have been made.  All questions and comments are"
  174.   CurrentX = 40
  175.   Print "welcome by e-mail at:   newvision@imt.net"
  176. End Sub
  177. Private Sub mnuList1_Click(index As Integer)
  178.   ' report the menu that was chosen
  179.   Dim msg$
  180.   msg$ = "You chose item number " & CStr(index + 1) & " from the Two Level Menu"
  181.   MsgBox msg$, 64, "Menu Columns Demo"
  182. End Sub
  183. Private Sub mnuList2_Click(index As Integer)
  184.   ' report the menu that was chosen
  185.   Dim msg$
  186.   msg$ = "You chose item number " & CStr(index + 1) & " from the first sub menu of the Three Level Menu"
  187.   MsgBox msg$, 64, "Menu Columns Demo"
  188. End Sub
  189. Private Sub mnuList3_Click(index As Integer)
  190.   ' report the menu that was chosen
  191.   Dim msg$
  192.   msg$ = "You chose item number " & CStr(index + 1) & " from the second sub menu of the Three Level Menu"
  193.   MsgBox msg$, 64, "Menu Columns Demo"
  194. End Sub
  195. Private Sub mnuList4_Click(index As Integer)
  196.   ' report the menu that was chosen
  197.   Dim msg$
  198.   msg$ = "You chose item number " & CStr(index + 1) & " from the popup sub menu of the Two Level Menu"
  199.   MsgBox msg$, 64, "Menu Columns Demo"
  200. End Sub
  201.